home *** CD-ROM | disk | FTP | other *** search
/ Merciful 5 / Merciful - Disc 5.iso / software / p / pcqpascalv1.2d.lha / Examples2 / Splitter / splitter.p
Text File  |  1997-05-06  |  3KB  |  143 lines
  1.  
  2.  
  3.  
  4. program splitter;
  5.  
  6. {
  7. *****  Quickhack, um eine große Datei in mehrere kleine  *****
  8.  
  9. *****  aufzuspalten.  (C) 1993 by B. Künnen         *****
  10. }
  11.  
  12. {$I "Include:libraries/dos.i" }
  13. {$I "Include:utils/stringlib.i" }
  14. {$I "Include:exec/memory.i" }
  15.  
  16. Const
  17.   bufsize = 64*1024;        { Größe des IO-Puffers }
  18.  
  19. VAR
  20.     ok      : Boolean;
  21.     mymem      : Address;
  22.     inFile      : String;
  23.     i,
  24.     num_files : Integer;
  25.     len      : Array[1..10] of Integer;
  26.     inhdl,
  27.     outhdl      : FileHandle;
  28.  
  29.  
  30. Procedure CleanExit(why : String;  rt : Integer);
  31. Begin
  32.   If inhdl  <> NIL then DosClose(  inhdl );
  33.   If outhdl <> NIL then DosClose( outhdl );
  34.   If mymem  <> NIL then FreeMem( mymem, bufsize );
  35.  
  36.   If why <> NIL then write(why);
  37.   Exit(rt);
  38. End;
  39.  
  40.  
  41. { Einlesen & Ausgabe der Daten }
  42.  
  43. Function SplitIO( num : Integer ): Boolean;
  44. Var
  45.   r,w,
  46.   rwlen,
  47.   outlen  : Integer;
  48.   buffer  : array[0..100] of Char;
  49.   NewName : String;
  50.   buflen  : integer;
  51.  
  52. Begin
  53.   NewName := Adr( buffer );
  54.   strcpy( NewName, inFile );
  55.  
  56.   { Name der Ausgabedatei = Eingabedatei+Nummer }
  57.   buflen := strlen( NewName );
  58.   NewName[buflen]   := chr( Byte('0') + num );
  59.   NewName[buflen+1] := chr(0);
  60.  
  61.   { Öffnen }
  62.   outhdl := DosOpen( NewName, Mode_NewFile );
  63.   If outhdl=NIL then SplitIO:=FALSE;
  64.  
  65.   { Länge dieser neuen Datei }
  66.   Write("Länge der ", num, ". Datei : ");
  67.   readln(outlen);
  68.   write("Moment...\n");
  69.  
  70.   { Jetzt in bufsize -großen Stücken umschaufeln }
  71.   REPEAT
  72.     if outlen>bufsize then 
  73.       rwlen := bufsize
  74.     else
  75.       rwlen := outlen;
  76.  
  77.     r := DosRead (  inhdl, mymem, rwlen );
  78.     w := DosWrite( outhdl, mymem, r );
  79.  
  80.     If r < rwlen then begin
  81.       write("Dateiende erreicht - Programmabbruch\n");
  82.       DosClose(outhdl);
  83.       outhdl := NIL;
  84.       SplitIO := FALSE;
  85.     End;
  86.  
  87.     If w < r then begin
  88.       Write("Fehler bei der Ausgabe in die Ziel Datei ", NewName, "\n" );    
  89.       DosClose( outhdl );
  90.       SplitIO := FALSE;
  91.     End;
  92.  
  93.     If outlen > bufsize then
  94.       outlen := outlen-bufsize
  95.     else
  96.      outlen := 0;
  97.  
  98.   UNTIL outlen=0;
  99.  
  100.   { Uuuuuuuuuuuuuuuuuuuuuuuuuuuuunnnd   .....  tschüß ! }
  101.   DosClose( outhdl );
  102.   SplitIO := TRUE;
  103. End;
  104.  
  105.  
  106.  
  107. { ---- Hauptschleife ---- }
  108.  
  109. Begin
  110.     inFile := AllocString(100);
  111.  
  112.     write("Welche Datei soll zerlegt werden ?  : ");
  113.     Readln(inFile);
  114.     If inFile^=chr(0) then CleanExit("Kein Dateiname angegeben.\n", 0);
  115.  
  116.  
  117.     inhdl := DosOpen( inFile, Mode_OldFile );
  118.     If inhdl=NIL then CleanExit("Kann Datei nicht öffnen.\n", 10);
  119.  
  120.  
  121.     mymem := AllocMem( bufsize, Memf_Public );
  122.     If mymem = NIL then CleanExit("Zu wenig Speicher", 20);
  123.  
  124.  
  125.     write("In wieviele Einzeldateien soll sie zerlegt werden ?  : ");
  126.     Readln(num_files);
  127.     If (num_files>10) OR (num_files<1)
  128.     then CleanExit("Min.1 & max. 10 Split-Dateien erlaubt.\n", 0);
  129.  
  130.     { Jetzt gehts los ... }
  131.  
  132.     for i := 1 to num_files do begin
  133.       ok := SplitIO( i );
  134.       If OK = False then CleanExit(NIL,0);
  135.     end;
  136.  
  137.     CleanExit(NIL,0);
  138. End.
  139.  
  140.  
  141.  
  142.  
  143.